home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / TVISION / TVEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-26  |  12KB  |  435 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal 6.0                             }
  4. {   Turbo Vision Editor Demo                     }
  5. {   Copyright (c) 1990 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program TVEdit;
  10.  
  11. {$M 8192,8192,655360}
  12. {$X+,S-}
  13.  
  14. { This program demonstrates the use of the Buffers and Editors
  15.   units. See also BUFFERS.DOC and EDITORS.DOC in the \TP\DOC
  16.   directory.
  17. }
  18.  
  19. uses Dos, Objects, Drivers, Memory, Views, Menus, Dialogs,
  20.   StdDlg, MsgBox, App, Calc, Buffers, Editors;
  21.  
  22. const
  23.   HeapSize = 32 * (1024 div 16);
  24.  
  25. const
  26.   cmOpen       = 100;    {command numbers are arbitrary but must be unique}
  27.   cmNew        = 101;
  28.   cmChangeDir  = 102;
  29.   cmDosShell   = 103;
  30.   cmCalculator = 104;
  31.   cmShowClip   = 105;
  32.   cmAbout      = 106;
  33.  
  34. type
  35.   PEditorApp = ^TEditorApp;
  36.   TEditorApp = object(TApplication)
  37.     constructor Init;
  38.     destructor Done; virtual;
  39.     procedure HandleEvent(var Event: TEvent); virtual;
  40.     procedure InitMenuBar; virtual;
  41.     procedure InitStatusLine; virtual;
  42.     procedure OutOfMemory; virtual;
  43.   end;
  44.  
  45. var
  46.   EditorApp: TEditorApp;
  47.   ClipWindow: PEditWindow;
  48.  
  49. function ExecDialog(P: PDialog; Data: Pointer): Word;
  50. var
  51.   Result: Word;
  52. begin
  53.   Result := cmCancel;
  54.   P := PDialog(Application^.ValidView(P));
  55.   if P <> nil then
  56.   begin
  57.     if Data <> nil then P^.SetData(Data^);
  58.     Result := DeskTop^.ExecView(P);
  59.     if (Result <> cmCancel) and (Data <> nil) then P^.GetData(Data^);
  60.     Dispose(P, Done);
  61.   end;
  62.   ExecDialog := Result;
  63. end;
  64.  
  65. function CreateFindDialog: PDialog;
  66. var
  67.   D: PDialog;
  68.   Control: PView;
  69.   R: TRect;
  70. begin
  71.   R.Assign(0, 0, 38, 12);
  72.   D := New(PDialog, Init(R, 'Find'));
  73.   with D^ do
  74.   begin
  75.     Options := Options or ofCentered;
  76.  
  77.     R.Assign(3, 3, 32, 4);
  78.     Control := New(PInputLine, Init(R, 80));
  79.     Insert(Control);
  80.     R.Assign(2, 2, 15, 3);
  81.     Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
  82.     R.Assign(32, 3, 35, 4);
  83.     Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
  84.  
  85.     R.Assign(3, 5, 35, 7);
  86.     Insert(New(PCheckBoxes, Init(R,
  87.       NewSItem('~C~ase sensitive',
  88.       NewSItem('~W~hole words only', nil)))));
  89.  
  90.     R.Assign(14, 9, 24, 11);
  91.     Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
  92.     Inc(R.A.X, 12); Inc(R.B.X, 12);
  93.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  94.  
  95.     SelectNext(False);
  96.   end;
  97.   CreateFindDialog := D;
  98. end;
  99.  
  100. function CreateReplaceDialog: PDialog;
  101. var
  102.   D: PDialog;
  103.   Control: PView;
  104.   R: TRect;
  105. begin
  106.   R.Assign(0, 0, 40, 16);
  107.   D := New(PDialog, Init(R, 'Replace'));
  108.   with D^ do
  109.   begin
  110.     Options := Options or ofCentered;
  111.  
  112.     R.Assign(3, 3, 34, 4);
  113.     Control := New(PInputLine, Init(R, 80));
  114.     Insert(Control);
  115.     R.Assign(2, 2, 15, 3);
  116.     Insert(New(PLabel, Init(R, '~T~ext to find', Control)));
  117.     R.Assign(34, 3, 37, 4);
  118.     Insert(New(PHistory, Init(R, PInputLine(Control), 10)));
  119.  
  120.     R.Assign(3, 6, 34, 7);
  121.     Control := New(PInputLine, Init(R, 80));
  122.     Insert(Control);
  123.     R.Assign(2, 5, 12, 6);
  124.     Insert(New(PLabel, Init(R, '~N~ew text', Control)));
  125.     R.Assign(34, 6, 37, 7);
  126.     Insert(New(PHistory, Init(R, PInputLine(Control), 11)));
  127.  
  128.     R.Assign(3, 8, 37, 12);
  129.     Insert(New(PCheckBoxes, Init(R,
  130.       NewSItem('~C~ase sensitive',
  131.       NewSItem('~W~hole words only',
  132.       NewSItem('~P~rompt on replace',
  133.       NewSItem('~R~eplace all', nil)))))));
  134.  
  135.     R.Assign(17, 13, 27, 15);
  136.     Insert(New(PButton, Init(R, 'O~K~', cmOk, bfDefault)));
  137.     R.Assign(28, 13, 38, 15);
  138.     Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  139.  
  140.     SelectNext(False);
  141.   end;
  142.   CreateReplaceDialog := D;
  143. end;
  144.  
  145. function DoEditDialog(Dialog: Integer; Info: Pointer): Word; far;
  146. var
  147.   R: TRect;
  148.   T: TPoint;
  149. begin
  150.   case Dialog of
  151.     edOutOfMemory:
  152.       DoEditDialog := MessageBox('Not enough memory for this operation.',
  153.         nil, mfError + mfOkButton);
  154.     edReadError:
  155.       DoEditDialog := MessageBox('Error reading file %s.',
  156.         @Info, mfError + mfOkButton);
  157.     edWriteError:
  158.       DoEditDialog := MessageBox('Error writing file %s.',
  159.         @Info, mfError + mfOkButton);
  160.     edCreateError:
  161.       DoEditDialog := MessageBox('Error creating file %s.',
  162.         @Info, mfError + mfOkButton);
  163.     edSaveModify:
  164.       DoEditDialog := MessageBox('%s has been modified. Save?',
  165.         @Info, mfInformation + mfYesNoCancel);
  166.     edSaveUntitled:
  167.       DoEditDialog := MessageBox('Save untitled file?',
  168.         nil, mfInformation + mfYesNoCancel);
  169.     edSaveAs:
  170.       DoEditDialog := ExecDialog(New(PFileDialog, Init('*.*',
  171.         'Save file as', '~N~ame', fdOkButton, 101)), Info);
  172.     edFind:
  173.       DoEditDialog := ExecDialog(CreateFindDialog, Info);
  174.     edSearchFailed:
  175.       DoEditDialog := MessageBox('Search string not found.',
  176.         nil, mfError + mfOkButton);
  177.     edReplace:
  178.       DoEditDialog := ExecDialog(CreateReplaceDialog, Info);
  179.     edReplacePrompt:
  180.       begin
  181.         { Avoid placing the dialog on the same line as the cursor }
  182.         R.Assign(0, 1, 40, 8);
  183.         R.Move((Desktop^.Size.X - R.B.X) div 2, 0);
  184.         Desktop^.MakeGlobal(R.B, T);
  185.         Inc(T.Y);
  186.         if TPoint(Info).Y <= T.Y then
  187.           R.Move(0, Desktop^.Size.Y - R.B.Y - 2);
  188.         DoEditDialog := MessageBoxRect(R, 'Replace this occurence?',
  189.           nil, mfYesNoCancel + mfInformation);
  190.       end;
  191.   end;
  192. end;
  193.  
  194. function OpenEditor(FileName: FNameStr; Visible: Boolean): PEditWindow;
  195. var
  196.   P: PView;
  197.   R: TRect;
  198. begin
  199.   DeskTop^.GetExtent(R);
  200.   P := Application^.ValidView(New(PEditWindow,
  201.     Init(R, FileName, wnNoNumber)));
  202.   if not Visible then P^.Hide;
  203.   DeskTop^.Insert(P);
  204.   OpenEditor := PEditWindow(P);
  205. end;
  206.  
  207. constructor TEditorApp.Init;
  208. var
  209.   H: Word;
  210.   R: TRect;
  211. begin
  212.   H := PtrRec(HeapEnd).Seg - PtrRec(HeapPtr).Seg;
  213.   if H > HeapSize then BufHeapSize := H - HeapSize else BufHeapSize := 0;
  214.   InitBuffers;
  215.   TApplication.Init;
  216.   DisableCommands([cmSave, cmSaveAs, cmCut, cmCopy, cmPaste, cmClear,
  217.     cmUndo, cmFind, cmReplace, cmSearchAgain]);
  218.   EditorDialog := DoEditDialog;
  219.   ClipWindow := OpenEditor('', False);
  220.   if ClipWindow <> nil then
  221.   begin
  222.     Clipboard := ClipWindow^.Editor;
  223.     Clipboard^.CanUndo := False;
  224.   end;
  225. end;
  226.  
  227. destructor TEditorApp.Done;
  228. begin
  229.   TApplication.Done;
  230.   DoneBuffers;
  231. end;
  232.  
  233. procedure TEditorApp.HandleEvent(var Event: TEvent);
  234.  
  235. procedure About;
  236. var
  237.   D: PDialog;
  238.   Control: PView;
  239.   R: TRect;
  240. begin
  241.   R.Assign(0, 0, 40, 11);
  242.   D := New(PDialog, Init(R, 'About'));
  243.   with D^ do
  244.   begin
  245.     Options := Options or ofCentered;
  246.  
  247.     R.Grow(-1, -1);
  248.     Dec(R.B.Y, 3);
  249.     Insert(New(PStaticText, Init(R,
  250.       #13 +
  251.       ^C'Turbo Vision Editor Demo'#13 +
  252.       #13 +
  253.       ^C'Copyright (c) 1990'#13 +
  254.       #13 +
  255.       ^C'Borland International')));
  256.  
  257.     R.Assign(15, 8, 25, 10);
  258.     Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  259.   end;
  260.   if ValidView(D) <> nil then
  261.   begin
  262.     Desktop^.ExecView(D);
  263.     Dispose(D, Done);
  264.   end;
  265. end;
  266.  
  267.  
  268. procedure FileOpen;
  269. var
  270.   FileName: FNameStr;
  271. begin
  272.   FileName := '*.*';
  273.   if ExecDialog(New(PFileDialog, Init('*.*', 'Open file',
  274.     '~N~ame', fdOpenButton, 100)), @FileName) <> cmCancel then
  275.     OpenEditor(FileName, True);
  276. end;
  277.  
  278. procedure FileNew;
  279. begin
  280.   OpenEditor('', True);
  281. end;
  282.  
  283. procedure ChangeDir;
  284. begin
  285.   ExecDialog(New(PChDirDialog, Init(cdNormal, 0)), nil);
  286. end;
  287.  
  288. procedure DosShell;
  289. begin
  290.   DoneSysError;
  291.   DoneEvents;
  292.   DoneVideo;
  293.   DoneMemory;
  294.   SetMemTop(Ptr(BufHeapPtr, 0));
  295.   PrintStr('Type EXIT to return to TVEDIT...');
  296.   SwapVectors;
  297.   Exec(GetEnv('COMSPEC'), '');
  298.   SwapVectors;
  299.   SetMemTop(Ptr(BufHeapEnd, 0));
  300.   InitMemory;
  301.   InitVideo;
  302.   InitEvents;
  303.   InitSysError;
  304.   Redraw;
  305. end;
  306.  
  307. procedure ShowClip;
  308. begin
  309.   ClipWindow^.Select;
  310.   ClipWindow^.Show;
  311. end;
  312.  
  313. procedure Tile;
  314. var
  315.   R: TRect;
  316. begin
  317.   Desktop^.GetExtent(R);
  318.   Desktop^.Tile(R);
  319. end;
  320.  
  321. procedure Cascade;
  322. var
  323.   R: TRect;
  324. begin
  325.   Desktop^.GetExtent(R);
  326.   Desktop^.Cascade(R);
  327. end;
  328.  
  329. procedure Calculator;
  330. begin
  331.   DeskTop^.Insert(ValidView(New(PCalculator, Init)));
  332. end;
  333.  
  334. begin
  335.   TApplication.HandleEvent(Event);
  336.   case Event.What of
  337.     evCommand:
  338.       case Event.Command of
  339.         cmAbout: About;
  340.         cmOpen: FileOpen;
  341.         cmNew: FileNew;
  342.         cmChangeDir: ChangeDir;
  343.         cmDosShell: DosShell;
  344.         cmCalculator: Calculator;
  345.         cmShowClip: ShowClip;
  346.         cmTile: Tile;
  347.         cmCascade: Cascade;
  348.       else
  349.         Exit;
  350.       end;
  351.   else
  352.     Exit;
  353.   end;
  354.   ClearEvent(Event);
  355. end;
  356.  
  357. procedure TEditorApp.InitMenuBar;
  358. var
  359.   R: TRect;
  360. begin
  361.   GetExtent(R);
  362.   R.B.Y := R.A.Y + 1;
  363.   MenuBar := New(PMenuBar, Init(R, NewMenu(
  364.     NewSubMenu('~'#240'~', hcNoContext, NewMenu(
  365.       NewItem('~A~bout', '', kbNoKey, cmAbout, hcNoContext, nil)),
  366.     NewSubMenu('~F~ile', hcNoContext, NewMenu(
  367.       NewItem('~O~pen...', 'F3', kbF3, cmOpen, hcNoContext,
  368.       NewItem('~N~ew', '', kbNoKey, cmNew, hcNoContext,
  369.       NewItem('~S~ave', 'F2', kbF2, cmSave, hcNoContext,
  370.       NewItem('S~a~ve as...', '', kbNoKey, cmSaveAs, hcNoContext,
  371.       NewLine(
  372.       NewItem('~C~hange dir...', '', kbNoKey, cmChangeDir, hcNoContext,
  373.       NewItem('~D~OS shell', '', kbNoKey, cmDosShell, hcNoContext,
  374.       NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  375.       nil))))))))),
  376.     NewSubMenu('~E~dit', hcNoContext, NewMenu(
  377.       NewItem('~U~ndo', '', kbNoKey, cmUndo, hcNoContext,
  378.       NewLine(
  379.       NewItem('Cu~t~', 'Shift-Del', kbShiftDel, cmCut, hcNoContext,
  380.       NewItem('~C~opy', 'Ctrl-Ins', kbCtrlIns, cmCopy, hcNoContext,
  381.       NewItem('~P~aste', 'Shift-Ins', kbShiftIns, cmPaste, hcNoContext,
  382.       NewItem('~S~how clipboard', '', kbNoKey, cmShowClip, hcNoContext,
  383.       NewLine(
  384.       NewItem('~C~lear', 'Ctrl-Del', kbCtrlDel, cmClear, hcNoContext,
  385.       nil))))))))),
  386.     NewSubMenu('~S~earch', hcNoContext, NewMenu(
  387.       NewItem('~F~ind...', '', kbNoKey, cmFind, hcNoContext,
  388.       NewItem('~R~eplace...', '', kbNoKey, cmReplace, hcNoContext,
  389.       NewItem('~S~earch again', '', kbNoKey, cmSearchAgain, hcNoContext,
  390.       nil)))),
  391.     NewSubMenu('~W~indows', hcNoContext, NewMenu(
  392.       NewItem('~S~ize/move','Ctrl-F5', kbCtrlF5, cmResize, hcNoContext,
  393.       NewItem('~Z~oom', 'F5', kbF5, cmZoom, hcNoContext,
  394.       NewItem('~T~ile', '', kbNoKey, cmTile, hcNoContext,
  395.       NewItem('C~a~scade', '', kbNoKey, cmCascade, hcNoContext,
  396.       NewItem('~N~ext', 'F6', kbF6, cmNext, hcNoContext,
  397.       NewItem('~P~revious', 'Shift-F6', kbShiftF6, cmPrev, hcNoContext,
  398.       NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  399.       NewLine(
  400.       NewItem('Ca~l~culator', '', kbNoKey, cmCalculator, hcNoContext,
  401.       nil)))))))))),
  402.     nil))))))));
  403. end;
  404.  
  405. procedure TEditorApp.InitStatusLine;
  406. var
  407.   R: TRect;
  408. begin
  409.   GetExtent(R);
  410.   R.A.Y := R.B.Y - 1;
  411.   New(StatusLine, Init(R,
  412.     NewStatusDef(0, $FFFF,
  413.       NewStatusKey('~F2~ Save', kbF2, cmSave,
  414.       NewStatusKey('~F3~ Open', kbF3, cmOpen,
  415.       NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  416.       NewStatusKey('~F5~ Zoom', kbF5, cmZoom,
  417.       NewStatusKey('~F6~ Next', kbF6, cmNext,
  418.       NewStatusKey('~F10~ Menu', kbF10, cmMenu,
  419.       NewStatusKey('', kbCtrlF5, cmResize,
  420.       nil))))))),
  421.     nil)));
  422. end;
  423.  
  424. procedure TEditorApp.OutOfMemory;
  425. begin
  426.   MessageBox('Not enough memory for this operation.',
  427.     nil, mfError + mfOkButton);
  428. end;
  429.  
  430. begin
  431.   EditorApp.Init;
  432.   EditorApp.Run;
  433.   EditorApp.Done;
  434. end.
  435.